home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / langs / xlisp2.1 / xldist02.zoo / sources / xldmem.h < prev    next >
Encoding:
C/C++ Source or Header  |  1990-11-09  |  8.9 KB  |  306 lines
  1. /* xldmem.h - dynamic memory definitions */
  2. /*        Copyright (c) 1987, by David Michael Betz
  3.         All Rights Reserved
  4.         Permission is granted for unrestricted non-commercial use        */
  5.  
  6. /* small fixnum range */
  7. #define SFIXMIN            (-128)
  8. #define SFIXMAX            255
  9. #define SFIXSIZE        384
  10.  
  11. /* character range */
  12. #define CHARMIN            0
  13. #define CHARMAX            255
  14. #define CHARSIZE        256
  15.  
  16. /* new node access macros */
  17. #define ntype(x)        ((x)->n_type)
  18.  
  19. /* cons access macros */
  20. #define car(x)            ((x)->n_car)
  21. #define cdr(x)            ((x)->n_cdr)
  22. #define rplaca(x,y)        ((x)->n_car = (y))
  23. #define rplacd(x,y)        ((x)->n_cdr = (y))
  24.  
  25. /* symbol access macros */
  26. #define getvalue(x)         ((x)->n_vdata[0])
  27. #define setvalue(x,v)     ((x)->n_vdata[0] = (v))
  28. #define getfunction(x)     ((x)->n_vdata[1])
  29. #define setfunction(x,v) ((x)->n_vdata[1] = (v))
  30. #define getplist(x)         ((x)->n_vdata[2])
  31. #define setplist(x,v)     ((x)->n_vdata[2] = (v))
  32. #define getpname(x)         ((x)->n_vdata[3])
  33. #define setpname(x,v)     ((x)->n_vdata[3] = (v))
  34. #define SYMSIZE            4
  35.  
  36. /* closure access macros */
  37. #define getname(x)        ((x)->n_vdata[0])
  38. #define setname(x,v)    ((x)->n_vdata[0] = (v))
  39. #define gettype(x)        ((x)->n_vdata[1])
  40. #define settype(x,v)    ((x)->n_vdata[1] = (v))
  41. #define getargs(x)        ((x)->n_vdata[2])
  42. #define setargs(x,v)    ((x)->n_vdata[2] = (v))
  43. #define getoargs(x)        ((x)->n_vdata[3])
  44. #define setoargs(x,v)    ((x)->n_vdata[3] = (v))
  45. #define getrest(x)        ((x)->n_vdata[4])
  46. #define setrest(x,v)    ((x)->n_vdata[4] = (v))
  47. #define getkargs(x)        ((x)->n_vdata[5])
  48. #define setkargs(x,v)    ((x)->n_vdata[5] = (v))
  49. #define getaargs(x)        ((x)->n_vdata[6])
  50. #define setaargs(x,v)    ((x)->n_vdata[6] = (v))
  51. #define getbody(x)        ((x)->n_vdata[7])
  52. #define setbody(x,v)    ((x)->n_vdata[7] = (v))
  53. #define getenvi(x)        ((x)->n_vdata[8])
  54. #define setenvi(x,v)    ((x)->n_vdata[8] = (v))
  55. #define getfenv(x)        ((x)->n_vdata[9])
  56. #define setfenv(x,v)    ((x)->n_vdata[9] = (v))
  57. #define getlambda(x)    ((x)->n_vdata[10])
  58. #define setlambda(x,v)    ((x)->n_vdata[10] = (v))
  59. #define CLOSIZE            11
  60.  
  61. /* vector access macros */
  62. #define getsize(x)        ((x)->n_vsize)
  63. #define getelement(x,i) ((x)->n_vdata[i])
  64. #define setelement(x,i,v) ((x)->n_vdata[i] = (v))
  65.  
  66. /* object access macros */
  67. #define getclass(x)        ((x)->n_vdata[0])
  68. #define getivar(x,i)    ((x)->n_vdata[i+1])
  69. #define setivar(x,i,v)    ((x)->n_vdata[i+1] = (v))
  70.  
  71. /* subr/fsubr access macros */
  72. #define getsubr(x)        ((x)->n_subr)
  73. #define getoffset(x)    ((x)->n_offset)
  74.  
  75. /* fixnum/flonum/char access macros */
  76. #define getfixnum(x)    ((x)->n_fixnum)
  77. #define getflonum(x)    ((x)->n_flonum)
  78. #define getchcode(x)    ((x)->n_chcode)
  79.  
  80. /* string access macros */
  81. #define getstring(x)    ((x)->n_string)
  82. #define getslength(x)    ((x)->n_strlen)
  83. /* the following functions were TAA modifications */
  84. #define getstringch(x,i) (((unsigned char *)((x)->n_string))[i])
  85. #define setstringch(x,i,v) ((x)->n_string[i] = (char)(v))
  86.  
  87. /* file stream access macros */
  88. #define getfile(x)        ((x)->n_fp)
  89. #define setfile(x,v)    ((x)->n_fp = (v))
  90. #define getsavech(x)    ((x)->n_savech)
  91. #define setsavech(x,v)    ((x)->n_savech = (v))
  92.  
  93. /* unnamed stream access macros */
  94. #define gethead(x)        ((x)->n_car)
  95. #define sethead(x,v)    ((x)->n_car = (v))
  96. #define gettail(x)        ((x)->n_cdr)
  97. #define settail(x,v)    ((x)->n_cdr = (v))
  98.  
  99. /* node types */
  100. #define FREE    0
  101. #define SUBR    1
  102. #define FSUBR    2
  103. #define CONS    3
  104. #ifdef JGC
  105. #define FIXNUM    4
  106. #define FLONUM    5
  107. #define STRING    6
  108. #define STREAM    7
  109. #define CHAR    8
  110. #define USTREAM 9
  111. #define ARRAY    16        /* arrayed types */
  112. #define SYMBOL    (ARRAY+1)
  113. #define OBJECT    (ARRAY+2)
  114. #define VECTOR    (ARRAY+3)
  115. #define CLOSURE (ARRAY+4)
  116. #ifdef STRUCTS
  117. #define STRUCT    (ARRAY+5)
  118. #endif
  119. #define TYPEFIELD 0x1f
  120. #else
  121. #define SYMBOL    4
  122. #define FIXNUM    5
  123. #define FLONUM    6
  124. #define STRING    7
  125. #define OBJECT    8
  126. #define STREAM    9
  127. #define VECTOR    10
  128. #define CLOSURE 11
  129. #define CHAR    12
  130. #define USTREAM 13
  131. #ifdef STRUCTS
  132. #define STRUCT    14
  133. #endif
  134. #endif
  135. /* subr/fsubr node */
  136. #define n_subr            n_info.n_xsubr.xs_subr
  137. #define n_offset        n_info.n_xsubr.xs_offset
  138.  
  139. /* cons node */
  140. #define n_car            n_info.n_xcons.xc_car
  141. #define n_cdr            n_info.n_xcons.xc_cdr
  142.  
  143. /* fixnum node */
  144. #define n_fixnum        n_info.n_xfixnum.xf_fixnum
  145.  
  146. /* flonum node */
  147. #define n_flonum        n_info.n_xflonum.xf_flonum
  148. /* character node */
  149. #define n_chcode        n_info.n_xchar.xc_chcode
  150.  
  151. /* string node */
  152. #define n_string        n_info.n_xstring.xs_string
  153. #define n_strlen        n_info.n_xstring.xs_length
  154.  
  155. /* stream node */
  156. #define n_fp            n_info.n_xstream.xs_fp
  157. #define n_savech        n_info.n_xstream.xs_savech
  158. #ifdef BETTERIO
  159. #define S_READING        1
  160. #define S_WRITING        2
  161. #define n_sflags        n_info.n_xstream.xs_flags
  162. #endif
  163.  
  164. /* vector/object node */
  165. #define n_vsize            n_info.n_xvector.xv_size
  166. #define n_vdata            n_info.n_xvector.xv_data
  167.  
  168. /* node structure */
  169. typedef struct node {
  170. #ifndef __HIGHC__
  171.     char n_type;                /* type of node */
  172. #ifndef JGC
  173.     char n_flags;                /* flag bits */
  174. #endif
  175. #endif
  176.     union ninfo {                /* value */
  177.         struct xsubr {            /* subr/fsubr node */
  178. #ifdef ANSI
  179.             struct node *(*xs_subr)(void);    /* function pointer */
  180. #else
  181.             struct node *(*xs_subr)();    /* function pointer */
  182. #endif
  183.             int xs_offset;                /* offset into funtab */
  184.         } n_xsubr;
  185.         struct xcons {            /* cons node */
  186.             struct node *xc_car;        /* the car pointer */
  187.             struct node *xc_cdr;        /* the cdr pointer */
  188.         } n_xcons;
  189.         struct xfixnum {        /* fixnum node */
  190.             FIXTYPE xf_fixnum;            /* fixnum value */
  191.         } n_xfixnum;
  192.         struct xflonum {        /* flonum node */
  193.             FLOTYPE xf_flonum;            /* flonum value */
  194.         } n_xflonum;
  195.         struct xchar {            /* character node */
  196.             int xc_chcode;                /* character code */
  197.         } n_xchar;
  198.         struct xstring {        /* string node */
  199.             int xs_length;                /* string length */
  200.             char *xs_string;            /* string pointer */
  201.         } n_xstring;
  202.         struct xstream {        /* stream node */
  203.             FILE *xs_fp;                /* the file pointer */
  204. #ifdef BETTERIO
  205.             char xs_savech;
  206.             char xs_flags;
  207. #else
  208.             int xs_savech;                /* lookahead character */
  209. #endif
  210.         } n_xstream;
  211.         struct xvector {        /* vector/object/symbol/structure node */
  212.             int xv_size;                /* vector size */
  213.             struct node **xv_data;        /* vector data */
  214.         } n_xvector;
  215.     } n_info;
  216. #ifdef __HIGHC__
  217.     char n_type;                /* type of node */
  218. #ifndef JGC
  219.     char n_flags;                /* flag bits */
  220. #endif
  221. #endif
  222. } *LVAL;
  223.  
  224. /* memory segment structure definition */
  225. typedef struct segment {
  226.     int sg_size;
  227.     struct segment *sg_next;
  228.     struct node sg_nodes[1];
  229. } SEGMENT;
  230.  
  231. /* memory allocation functions */
  232. #ifdef ANSI
  233. extern void gc(void);                /* do a garbage collect */
  234. extern SEGMENT *newsegment(int n);    /* create a new segment */
  235. extern LVAL cons(LVAL x, LVAL y);    /* (cons x y) */
  236. extern LVAL cvsymbol(char *pname);    /* convert a string to a symbol */
  237. extern LVAL cvstring(char *str);    /* convert a string */
  238. extern LVAL cvfile(FILE *fp);        /* convert a FILE * to a file */
  239. extern LVAL cvsubr(LVAL (*fcn)(void), int type, int offset);
  240.                                 /* convert a function to a subr/fsubr */
  241. #ifdef JMAC
  242. extern LVAL Cvfixnum(FIXTYPE n);    /* convert a fixnum */
  243. extern LVAL Cvchar(int n);            /* convert a character */
  244. #else
  245. extern LVAL cvfixnum(FIXTYPE n);    /* convert a fixnum */
  246. extern LVAL cvchar(int n);            /* convert a character */
  247. #endif
  248. extern LVAL cvflonum(FLOTYPE n);    /* convert a flonum */
  249.  
  250. extern LVAL newstring(int size);    /* create a new string */
  251. extern LVAL newvector(int size);    /* create a new vector */
  252. extern LVAL newobject(LVAL cls, int size);    /* create a new object */
  253. extern LVAL newclosure(LVAL name, LVAL type, LVAL env, LVAL fenv);
  254.                                     /* create a new closure */
  255. extern LVAL newustream(void);        /* create a new unnamed stream */
  256. #ifdef STRUCTS
  257. extern LVAL newstruct(LVAL type, int size);    /* create a new structure */
  258. #endif
  259. #else
  260. extern VOID gc();                /* do a garbage collect */
  261. extern SEGMENT *newsegment();    /* create a new segment */
  262. extern LVAL cons();                /* (cons x y) */
  263. extern LVAL cvsymbol();            /* convert a string to a symbol */
  264. extern LVAL cvstring();            /* convert a string */
  265. extern LVAL cvfile();            /* convert a FILE * to a file */
  266. extern LVAL cvsubr();            /* convert a function to a subr/fsubr */
  267. #ifdef JMAC
  268. extern LVAL Cvfixnum();            /* convert a fixnum */
  269. extern LVAL Cvchar();            /* convert a character */
  270. #else
  271. extern LVAL cvfixnum();            /* convert a fixnum */
  272. extern LVAL cvchar();            /* convert a character */
  273. #endif
  274. extern LVAL cvflonum();        /* convert a flonum */
  275.  
  276. extern LVAL newstring();        /* create a new string */
  277. extern LVAL newvector();        /* create a new vector */
  278. extern LVAL newobject();        /* create a new object */
  279. extern LVAL newclosure();        /* create a new closure */
  280. extern LVAL newustream();        /* create a new unnamed stream */
  281. #ifdef STRUCTS
  282. extern LVAL newstruct();        /* create a new structure */
  283. #endif
  284. #endif
  285.  
  286. #ifdef JMAC
  287. /* Speed ups, reduce function calls for fixed characters and numbers       */
  288. /* Speed is exeptionaly noticed on machines with a large instruction cache */
  289. /* No size effects here (JonnyG) */
  290.  
  291. extern SEGMENT *fixseg,*charseg;
  292. extern FIXTYPE _tfixed;
  293. extern int _tint;
  294.  
  295. #define cvfixnum(n) ((_tfixed = n), \
  296.                 ((_tfixed > SFIXMIN && _tfixed < SFIXMAX) ? \
  297.                 &fixseg->sg_nodes[(int)_tfixed-SFIXMIN] : \
  298.                 Cvfixnum(_tfixed)))
  299.  
  300. #define cvchar(c) ((_tint = c), \
  301.                 ((_tint >= CHARMIN && _tint <= CHARMAX) ? \
  302.                         &charseg->sg_nodes[_tint-CHARMIN] : \
  303.                 Cvchar(_tint)))
  304.  
  305. #endif
  306.